Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/djscan/djscan.ctl

Text File | 1998-11-22 | 7KB | 242 lines

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.UserControl DJScan
   ClientHeight    =   1470
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2730
   ScaleHeight     =   1470
   ScaleWidth      =   2730
   ToolboxBitmap   =   "DJScan.ctx":0000
   Begin VB.TextBox txtOpen
      Height          =   330
      Left            =   45
      Locked          =   -1  'True
      TabIndex        =   1
      TabStop         =   0   'False
      Text            =   "Click here to load app for scan"
      Top             =   30
      Width           =   2400
   End
   Begin VB.ListBox lstDepend
      Height          =   840
      ItemData        =   "DJScan.ctx":0312
      Left            =   855
      List            =   "DJScan.ctx":0314
      TabIndex        =   0
      Top             =   435
      Width           =   1605
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   165
      Top             =   795
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
End
Attribute VB_Name = "DJScan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private mstrPath As String

Public Sub OpenFile()
Attribute OpenFile.VB_Description = "Open Win32 application from within code. Bypasses user click."
  Dim strfile As String
  On Error GoTo errHandle

  With CommonDialog1
    .Filter = "*.*"
    .CancelError = True
    .Flags = cdlOFNNoChangeDir + cdlOFNExplorer _
      + cdlOFNHideReadOnly
    If Len(mstrPath) > 0 Then .InitDir = mstrPath
    .ShowOpen

    mstrPath = fixPath(.FileName)
    strfile = .FileName
  End With
  Close
  txtOpen = strfile
  Call FindDependants(strfile)

Exit_Here:
  Exit Sub
errHandle:
  MsgBox Err.Description, , "DJScan: OpenFile"
  Resume Exit_Here
End Sub
Private Function fixPath(strX As String) As String
  Dim strY As String
  Do
    strY = Right$(strX, 1)
    strX = Left$(strX, Len(strX) - 1)
  Loop Until strY = "\"
  fixPath = strX & strY
End Function

Private Sub txtOpen_Click()
  Call OpenFile
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
End Sub

Private Sub UserControl_Resize()
  Dim intW As Integer

  On Error Resume Next
  intW = UserControl.Width
  With txtOpen
    .Move 0, 0, intW
    lstDepend.Move 0, .Height, _
    intW, UserControl.Height - .Height
  End With
End Sub

Private Function CountPages(FileName As String) As Long
  On Error GoTo errHandle
  Dim lngX As Long
  Open FileName For Random As #1 Len = 258
    lngX = LOF(1) / 256
  Close
  CountPages = lngX

Exit_Here:
  Exit Function
errHandle:
  MsgBox Err.Description, , "DJScan: CountPages"
  Stop
End Function

Public Sub FindDependants(FileName As String)
Attribute FindDependants.VB_Description = "Identify all dependencies of a given Win32 application"
  Dim lngP As Long
  Dim lngMax As Long
  Dim strPage As String * 256
  On Error GoTo errHandle

  UserControl.MousePointer = vbHourglass
  lngMax = CountPages(FileName)
  lstDepend.Clear
  Open FileName For Random As #1 Len = 256
    For lngP = 1 To lngMax
      Get 1, lngP, strPage
      Call SearchPage(strPage, lngP, ".DLL")
      Call SearchPage(strPage, lngP, ".OCX")
      DoEvents
    Next
  Close
  If lstDepend.ListCount = 0 Then
    lstDepend.AddItem "No DLL or OCX dependents found"
  End If
  UserControl.MousePointer = vbDefault

Exit_Here:
  Exit Sub
errHandle:
  MsgBox Err.Description, , "DJScan: FindDependants"
End Sub

Private Sub SearchPage(Page As String, PageNum As Long, _
SearchFor As String)
  Dim intC As Integer
  Dim strX As String
  Dim strP As String
  Dim strPage As String * 256
  On Error GoTo errHandle

  intC = InStr(UCase(Page), SearchFor)
  If intC > 0 Then
    strX = GetDepName(Page, intC)
    If intC < 16 And Right(strX, 1) = "?" Then
      If PageNum > 1 Then
        Get 1, PageNum - 1, strPage
        strP = GetDepName(strPage, 256)
      End If
      strX = strP & Left(strX, Len(strX) - 1)
    End If
    If Not Duplicate(strX) Then
      If Len(strX) < 6 Then strX = strX & "?"
      lstDepend.AddItem strX
    End If
  End If

Exit_Here:
  Exit Sub
errHandle:
  MsgBox Err.Description, , "DJScan: Searchpage"
End Sub
Private Function Duplicate(Check As String) As Boolean
  Dim intX As Integer

  With lstDepend
    For intX = 0 To .ListCount - 1
      If .List(intX) = Check Then
        Duplicate = True
        Exit Function
      End If
    Next
  End With
  Duplicate = False
End Function

Private Function GetDepName(Page As String, Place As Integer) As String
  Dim strX As String
  Dim strC As String
  Dim intX As Integer
  On Error GoTo errHandle

  strX = UCase("_abcdefghijklmnopqrstuvwxyz.-0123456789")
  strC = Mid(Page, Place - intX, 1)
  Do Until (InStr(strX, UCase(strC)) = 0) Or (Place - intX < 1)
    intX = intX + 1
    If Place - intX < 1 Then Exit Do
    strC = Mid(Page, Place - intX, 1)
  Loop
  GetDepName = Mid(Page, Place - (intX - 1), intX + 3)
  If Place - intX < 1 Then
    GetDepName = GetDepName & "?"
    'mark return string for search in previous page
  End If
Exit_Here:
  Exit Function
errHandle:
  MsgBox Err.Description, , "DJScan: GetDepName"
End Function
Public Function GetList() As String
Attribute GetList.VB_Description = "Return list of dependents found."
  Dim intX As Integer
  Dim strX As String

  With lstDepend
    For intX = 0 To .ListCount - 1
      strX = strX & .List(intX) & vbCrLf
    Next
  End With
  GetList = strX
End Function

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Sets/returns enabled status of control"
  Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
  UserControl.Enabled() = New_Enabled
  PropertyChanged "Enabled"
End Property